;; collection/pt.scm - (c) rohan drape, 2001-2005

;; A <pt> is a <list>.

(define make-pt list)
(define pt-x    car)
(define pt-y    cadr)
(define pt-ref  list-ref)
(define pt-set! list-set!)

;; Function generators

(define-syntax define-ptUop
  (syntax-rules ()
    ((_ name comb op) 
     (defineL (name {x y}) (comb (op x) (op y))))))

(define-syntax define-ptBop
  (syntax-rules ()
    ((_ name comb op) 
     (defineL (name {x1 y1} {x2 y2}) (comb (op x1 x2) (op y1 y2))))))

;; <pt> comparison.

(define-ptBop pt-=?  and =)
(define-ptBop pt->?  and >)
(define-ptBop pt->=? and >=)
(define-ptBop pt-<?  and <)
(define-ptBop pt-<=? and <=)

;; Binary <pt> math.

(define-ptBop pt-+  make-pt +)
(define-ptBop pt-*  make-pt *)
(define-ptBop pt-/  make-pt /)
(define-ptBop pt--  make-pt -)

;; Unary <pt> math.

(define-ptUop pt-negative make-pt -)
(define-ptUop pt-abs      make-pt abs)
(define-ptUop pt-floor    make-pt floor)
(define-ptUop pt-ceiling  make-pt ceiling)
(define-ptUop pt-truncate make-pt truncate)
(define-ptUop pt-round    make-pt round)

;; Scalar <pt> math.

(defineL (pt-translate {x y} {n}) {make-pt (+ x n) (+ y n)})
(defineL (pt-scale {x y} {n}) {make-pt (* x n) (* y n)})

;; Inverse of `a' about `b'.

(define (pt-inverse a b) (pt-+ (pt-- b a) b))

;; Polar accessors.

(defineL (pt-rho {x y}) (hypotenuse x y))
(defineL (pt-theta {x y}) (atan2* y x))
(defineL (pt->polar {x y}) {make-pt (hypotenuse x y) (atan2* y x)})
(defineL (polar->pt {rho theta}) {make-pt (* rho (cos theta)) (* rho (sin theta))})

;; x->y & y->x

(defineL (pt-transpose {x y}) {make-pt y x})

;; <vector> translators.

(define (vector->pt v) {make-pt (vector-ref v 0) (vector-ref v 1)})
(defineL (pt->vector {x y}) (vector x y))

;; Calculate the straight line distance between two <pt>s.

(defineL (pt-distance {x1 y1} {x2 y2}) (hypotenuse (- x2 x1) (- y2 y1)))

;; Special case for distance from the origin.

(defineL (pt-distance0 {x y}) (hypotenuse x y))

;; Generate a set of <pt>s on the line from `a' to `b' with an x axis
;; distance increment of `xn'.

(define (pt-generate-line a b xn)
  (let* ((d (pt-- b a))
	 (left-right? (> (pt-x d) 0))
	 (end-test? (if left-right? >= <=))
	 (dx (if left-right? xn (- xn)))
	 (incr (make-pt dx (/* (pt-y d) (/ (pt-x d) dx)))))
    (let loop ((line (list a)) 
	       (p a))
      (if (end-test? (pt-x p) (pt-x b))
	  (reverse line)
	  (let ((z (pt-+ p incr)))
	    (loop (cons z line) z))))))

;; Binary input and output of <pt> data.

(define (read-pt/float32 port)
  {make-pt (read-float32 port) 
	    (read-float32 port)})

(defineL (write-pt/float32 {x y} {port})
  (write-float32 x port)
  (write-float32 y port))
